home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / mh.tcl.z / mh.tcl
Text File  |  2002-07-08  |  33KB  |  1,111 lines
  1. #
  2. # mh.tcl --
  3. #    MH support. This is divided into two parts:
  4. #        Thin layers on the MH commands
  5. #        Parsing and setting up the mhProfile
  6. #
  7. # Copyright (c) 1993 Xerox Corporation.
  8. # Use and copying of this software and preparation of derivative works based
  9. # upon this software are permitted. Any distribution of this software or
  10. # derivative works must comply with all applicable United States export
  11. # control laws. This software is made available AS IS, and Xerox Corporation
  12. # makes no warranty about the software, its performance or its conformity to
  13. # any specification.
  14.  
  15. proc Mh_Init {} {
  16.     global exmh nmh
  17.     MhParseProfile
  18.  
  19.     set nmh 0
  20.     catch {string match *group* [MhExec repl -help] } nmh
  21.  
  22.     # set $exmh(mh_vers) to a pretty-printable string...
  23.     set exmh(mh_vers) "unknown"
  24.     if { $nmh } {
  25.     # 'repl -- version [compiled etc etc]' - catch version
  26.     catch {MhExec repl -version} d
  27.     regexp {.*-- *([^ ]*)[ ]} $d {} exmh(mh_vers) 
  28.     } else {
  29.     # UCI MH - 'version: .*'
  30.     # weirdness - 6.8 puts 'version (build on ...)', 6.6 (blech) doesnt.
  31.     catch {MhExec repl -help} d
  32.     set d1 [ split $d "\n"]
  33.     foreach line $d1 {
  34.         regexp {^version:[ ]*([^(]*)} $line d2
  35.         if [info exists d2] { set exmh(mh_vers) [string trim $d2] }
  36.     }
  37.     }
  38. }
  39.  
  40. proc Mh_Preferences {} {
  41.     global mhProfile
  42.     Preferences_Add "MH Tweaks" \
  43. "Note that most of MH is parameterized by your [file tail $mhProfile(profile)] file.
  44. These options just affect a few things particular to exmh." [list \
  45.     {mhProfile(scan-proc) scanProc {scan -noheader} {Scan program}
  46. "If you have a custom scan program, name it here."} \
  47.     {mhProfile(sendType) sendType {CHOICE wait async xterm} {How to send messages}
  48. "There are three ways exmh can send a message for you:
  49. wait: exmh waits until the message is successfully posted.
  50. It displayes any error messages and lets you retry after a failure.
  51. async: exmh does not wait for the message to be posted.
  52. If there are errors, they are mailed back to you.
  53. xterm: exmh runs send in an xterm.  Exmh does not wait for
  54. your interaction with send to complete."} \
  55.     {mhProfile(xtermcmd) xtermCmd {xterm -g 80x5} {xterm command parameters}
  56. "When \"Send in xterm window\" is selected,
  57. this option controls extra parameters provided
  58. to the xterm program to control how it is started."} \
  59.     {mhProfile(forwtweak) forwTweak ON {Tweak subject lines of forwarded messages}
  60. "If this option is enabled, the subject line of forwarded messages
  61. will be tweaked, in a similar manner to the prefixing of \"Re:\" to
  62. the subject of replies.  This is only performed if the draft message
  63. does not already contain a subject line (or if it is empty), as given
  64. in your forwcomps file."} \
  65.     {mhProfile(forwsubj) forwSubj {$subj (fwd)} {Subject line for forwarded messages}
  66. "When \"Tweak subject lines of forwarded messages\" is enabled, this
  67. option specifies the particular tweak to perform.  This usually consists
  68. of suffixing \"(fwd)\" or prefixing \"Fw:\" (both of which are removed
  69. if present in the original subject line).  The variable \$subj here is
  70. replaced with the subject of the original message."} \
  71.     [list mhProfile(delprefix) delPrefix [MhBackup] {Prefix of rmm'd files} \
  72. "The Delete operation in MH really only renames a message file to have
  73. a prefix like # or , (comma).  This prefernce setting is used to
  74. set that prefix if you have a custom remove proc. The default setting is
  75. correct for your version of MH."] \
  76.     {mhProfile(purgeage) purgeAge 7 {Age, in days of files to purge}
  77. "The Purge operation will remove deleted messages that are older
  78. than this number of days."} \
  79.     ]
  80.     #
  81.     # Backwards compatibility.  Nuke when 1.6alpha and 1.5.3 are dead.
  82.     #
  83.     set async [option get . sendAsync {}]
  84.     if {[string length $async]} {
  85.     set mhProfile(sendType) [expr {$async ? "async" : "wait"}]
  86.     }
  87. }
  88.  
  89. proc MhBackup {} {
  90.     set sbackup {}
  91.     catch {set sbackup [exec mhparam sbackup]}
  92.     if {[string length $sbackup] == 0} {
  93.     catch {exec mhparam -help} x
  94.     regexp {SBACKUP="\"([^\"]+)\""} $x match sbackup
  95.     }
  96.     if {[string length $sbackup] == 0} {
  97.     set sbackup #
  98.     }
  99.     return $sbackup
  100. }
  101.  
  102. # Run an MH program and check for errors.
  103. # If the context file gets corrupted, just remove it and try again.
  104. proc MhExec { args } {
  105.     global mhProfile
  106.     Audit $args
  107.     if {[catch {eval exec $args} result]} {
  108.     global errorInfo
  109.     if {[regexp {exmhcontext is poorly formatted} $result]} {
  110.         Exmh_Status "Resetting .exmhcontext" error
  111.         exec cat /dev/null > $mhProfile(path)/.exmhcontext
  112.         return [eval exec $args]
  113.     } else {
  114.         error $result $errorInfo
  115.     }
  116.     } else {
  117. #    These Exmh_Debug calls break up the atomicity of commit actions
  118. #    by the background process because of Tk send and timer handling.
  119. #    The periodic maintenence task can sneak in on us.
  120. #    Exmh_Debug MhExec $args
  121.     return $result
  122.     }
  123. }
  124.  
  125. # The following are default comp, repl, and forw setup procedures
  126. # passed to Msg_Comp, Msg_Reply, and Msg_Forward, respectively.
  127. proc Mh_CompSetup {} {
  128.     global exmh mhProfile msg
  129.     set indrafts [expr \
  130.     {[string compare $exmh(folder) $mhProfile(draft-folder)] == 0}]
  131.     if {$indrafts && ([string length $msg(id)] != 0)} {
  132.     Exmh_Status "comp -use $msg(id)"
  133.     Mh_SetCur $mhProfile(draft-folder) $msg(id)
  134.     } else {
  135.         set path [Mh_FindFile "components"]
  136.     if {0 != [string length $path]} {
  137.         Exmh_Status "comp -form $path/components"
  138.         MhExec comp -nowhatnowproc -form $path/components
  139.     } else {
  140.         Exmh_Status "comp"
  141.         MhExec comp -nowhatnowproc
  142.     }
  143.     if {$indrafts} {
  144.         # In drafts with no previously current message
  145.         Scan_Folder $exmh(folder)
  146.         Msg_Change [Mh_Sequence $exmh(folder) cur]
  147.         if {[Mh_Cur $exmh(folder)] == {}} {
  148.         # Scan_Folder destroyed the cur sequence (drafts must
  149.         # have been empty). Restore it.
  150.         Msg_CheckPoint
  151.         }
  152.     }
  153.     }
  154.     set exmh([Mh_Cur $mhProfile(draft-folder)],action) comp
  155. }
  156. proc Mh_CompUseSetup {} {
  157.     global exmh msg
  158.     if {$msg(id) != {}} {
  159.     Exmh_Status "comp -use $msg(id)"
  160.     MhExec comp +$exmh(folder) $msg(id) -nowhatnowproc
  161.     } else {
  162.     Exmh_Status "No current message" warn
  163.     }
  164.     set exmh([Mh_Cur $mhProfile(draft-folder)],action) comp
  165. }
  166. proc Mh_ReplySetup { folder msg } {
  167.     global mhProfile exmh
  168.     set path [Mh_FindFile "replcomps"]
  169.     if {0 != [string length $path]} {
  170.     Exmh_Status "repl +$folder $msg -form $path/replcomps"
  171.     MhExec repl +$folder $msg -nowhatnowproc -nocc cc -nocc to -form $path/replcomps
  172.     } else {
  173.     Exmh_Status "repl +$folder $msg"
  174.     MhExec repl +$folder $msg -nowhatnowproc -nocc cc -nocc to
  175.     }
  176.     MhAnnoSetup $folder $msg repl
  177. }
  178. proc Mh_ReplyAllSetup { folder msg } {
  179.     global mhProfile exmh
  180.     set path [Mh_FindFile "replcomps"]
  181.     if {0 != [string length $path]} {
  182.     Exmh_Status "repl +$folder $msg -form $path/replcomps"
  183.     MhExec repl +$folder $msg -nowhatnowproc -cc cc -cc to -form $path/replcomps
  184.     } else {
  185.     Exmh_Status "repl +$folder $msg"
  186.     MhExec repl +$folder $msg -nowhatnowproc -cc cc -cc to
  187.     }
  188.     MhAnnoSetup $folder $msg repl
  189. }
  190. proc Mh_Forw_MungeSubj { folder msgs } {
  191.     global mhProfile
  192.     set draftID [Mh_Cur $mhProfile(draft-folder)]
  193.     if {![catch {eval exec scan +$folder -noheader -format "%{subject}" $msgs} subj]} {
  194.     # just take the first line of $subj (in case of >1 messages)
  195.     set subj [lindex [split $subj "\n"] 0]
  196.     # strip off leading and trailing "fw:", "(fwd)", "<fwd>" and whitespace
  197.     regsub -nocase "^(\[     \]*((fwd?:)|(\\(fwd?\\))|(<fwd?>)))*" $subj {} subj
  198.     regsub -nocase "(((\\(fwd?\\))|(<fwd?>))\[     \]*)*$" $subj {} subj
  199.     set subj [string trim $subj]
  200.     # quote any rogue \'s or &'s in the subject line
  201.     regsub -all {\\} $subj {\\\\} subj
  202.     regsub -all {&} $subj {\\\&} subj
  203.     # now do the required munging, and quote \'s and &'s again
  204.     regsub -all {\$subj} $mhProfile(forwsubj) $subj subj
  205.     regsub -all {\\} $subj {\\\\} subj
  206.     regsub -all {&} $subj {\\\&} subj
  207.     catch {
  208.         set fd [open $mhProfile(path)/$mhProfile(draft-folder)/$draftID r]
  209.         set msgtxt [read $fd]
  210.         close $fd
  211.         if {[regexp -indices "\n(--+)?(\n|\$)" $msgtxt posn]} {
  212.         set cpos [lindex $posn 0]
  213.         set hdrtxt [string range $msgtxt 0 [expr {$cpos-1}]]
  214.         set bodytxt [string range $msgtxt $cpos end]
  215.         } else {
  216.         set hdrtxt $msgtxt
  217.         set bodytxt {}
  218.         }
  219.         unset msgtxt
  220.         if {[regexp "^|\n\[Ss\]ubject:" $hdrtxt]} {
  221.         regsub "(^|\n)(\[Ss\]ubject:)\[     \]*(\n|\$)" $hdrtxt "\\1\\2 $subj\\3" nhdrtxt
  222.         } else {
  223.         set nhdrtxt "$hdrtxt\nSubject: $subj"
  224.         }
  225.         set fd [open $mhProfile(path)/$mhProfile(draft-folder)/$draftID w]
  226.         puts -nonewline $fd $nhdrtxt
  227.         puts -nonewline $fd $bodytxt
  228.         close $fd
  229.     }
  230.     }
  231. }
  232. proc Mh_ForwSetup { folder msgs } {
  233.     global mhProfile exmh
  234.     set path [Mh_FindFile "forwcomps"]
  235.     if {0 != [string length $path]} {
  236.     Exmh_Status "forw +$folder $msgs -form $path/forwcomps"
  237.     eval {MhExec forw +$folder} $msgs -nowhatnowproc -form $path/forwcomps
  238.     } else {
  239.     Exmh_Status "forw +$folder $msgs"
  240.     eval {MhExec forw +$folder} $msgs -nowhatnowproc
  241.     }
  242.     MhAnnoSetup $folder $msgs forw
  243.     if {$mhProfile(forwtweak)} {
  244.     Mh_Forw_MungeSubj $folder $msgs
  245.     }
  246. }
  247. proc Mh_DistSetup { folder msg } {
  248.     global exmh mhProfile
  249.     set path [Mh_FindFile "distcomps"]
  250.     if {0 != [string length $path]} {
  251.     Exmh_Status "dist +$folder $msg -form $path/distcomps"
  252.         MhExec dist +$folder $msg -nowhatnowproc -form $path/distcomps
  253.     } else {
  254.         Exmh_Status "dist +$folder $msg"
  255.         MhExec dist +$folder $msg -nowhatnowproc
  256.     }
  257.     MhAnnoSetup $folder $msg dist
  258. }
  259. proc MhAnnoSetup { folder msg key args } {
  260.     global mhProfile exmh
  261.     set draftID [Mh_Cur $mhProfile(draft-folder)]
  262.     set exmh($draftID,mhaltmsg) $mhProfile(path)/$folder/$msg
  263.     set exmh($draftID,mhfolder) $mhProfile(path)/$folder
  264.     set exmh($draftID,folder) $folder
  265.     set exmh($draftID,mhmessages) $msg
  266.     set exmh($draftID,action) $key
  267.     Exmh_Debug MhAnnoSetup action $key for $draftID
  268.  
  269.     # I don't assume both alternative options will be set together
  270.     set noannoIX [lsearch $args -noannotate]
  271.     set annoIX [lsearch $args -annotate]
  272.     if { ($exmh(anno,$key) || ($annoIX >= 0)) &&  ($noannoIX < 0) } {
  273.         set exmh($draftID,mhanno$key) 1
  274.     }
  275.  
  276.     set noinplaceIX [lsearch $args -noinplace]
  277.     set inplaceIX [lsearch $args -inplace]
  278.     if { ($exmh(inplace,$key) || ($inplaceIX >= 0)) && \
  279.          ($noinplaceIX < 0) } {
  280.             set exmh($draftID,mhinplace$key) 1
  281.     }
  282. }
  283. proc Mh_AnnoEnviron { draftID } {
  284.     global exmh env
  285.     if {![info exists exmh($draftID,mhaltmsg)]} {
  286.     return 0
  287.     }
  288.     set env(mhaltmsg) $exmh($draftID,mhaltmsg)
  289.     set env(mhfolder) $exmh($draftID,mhfolder)
  290.     set env(mhmessages) $exmh($draftID,mhmessages)
  291.     if {[info exists exmh($draftID,mhinplace)]} {
  292.       set env(mhinplace) 1
  293.     }
  294.     if {$exmh($draftID,action) == "dist"} {
  295.     # dist requires annotation; it just does.
  296.     set env(mhdist) 1
  297.     set env(mhannodist) 1
  298.     set env(mhannotate) "Resent"
  299.     return [info exists exmh($draftID,mhannodist)]
  300.     }
  301.     if {[info exists exmh($draftID,mhannorepl)]} {
  302.     set env(mhannorepl) 1
  303.     set env(mhannotate) "Replied"
  304.     return $exmh($draftID,mhannorepl)
  305.     }
  306.     if {[info exists exmh($draftID,mhannoforw)]} {
  307.     set env(mhannoforw) 1
  308.     set env(mhannotate) "Forwarded"
  309.     return $exmh($draftID,mhannoforw)
  310.     }
  311.     return 0
  312. }
  313. proc Mh_AnnoCleanup { draftID } {
  314.     global exmh env
  315.     
  316.     foreach key {mhannoforw mhannorepl mhannodist mhannotate mhdist
  317.          mhaltmsg mhfolder mhmessages mhinplace folder action} {
  318.     if {[info exist exmh($draftID,$key)]} {
  319.         unset exmh($draftID,$key)    ;# Faster than catch-unset
  320.     }
  321.     if {[regexp ^mh $key]} {
  322.         catch {unset env($key)}
  323.     }
  324.     }
  325. }
  326.  
  327. proc Mh_Folder { f } {
  328.     if {[catch {MhExec folder +$f < /dev/null} info]} {
  329.     Exmh_Debug $info
  330.     return {}
  331.     } else {
  332.     if {[regexp {\+[^0-9]+ ([0-9]+) [^(]*\(([^)]+)\)} $info x total range]} {
  333.         regsub -all { } $range {} range
  334.         return "$f+ $total msgs ($range)"
  335.     } else {
  336.         return $info
  337.     }
  338.     }
  339. }
  340. proc Mh_FolderNew { f } {
  341.     Mh_SetContext Current-Folder $f
  342. }
  343. proc Mh_SetContext { key value } {
  344.     global mhProfile
  345.     set in [open $mhProfile(context) r]
  346.     if {[catch {open $mhProfile(context).new w} out] == 0} {
  347.     while {[gets $in line] >= 0} {
  348.         if {[regexp -nocase "^$key: (.*)$" $line match oldvalue]} {
  349.         puts $out "$key: $value"
  350.         } else {
  351.         if {$line != {}} {
  352.             puts $out $line
  353.         }
  354.         }
  355.     }
  356.     close $in
  357.     close $out
  358.     frename $mhProfile(context).new $mhProfile(context)
  359.     return $value
  360.     } else {
  361.     close $in
  362.     Exmh_Status "Cannot write $mhProfile(context).new" error
  363.     }
  364. }
  365. proc Mh_MsgChk {} {
  366.     global inc pop
  367.     
  368.     if {[string length $inc(pophost)]} {
  369.     # See if we know the password for this host
  370.     Pop_GetPassword $inc(pophost)
  371.     catch {exec msgchk -nodate -notify mail -host $inc(pophost) << $pop(password)} result
  372.     Exmh_Debug Mh_MsgChk $result
  373.     # Remove 'Password (host:user):' prompt from result string, and
  374.     # msgchk returned 1 because no messages were waiting, remove the
  375.     # error message left by 'exec'
  376.     regsub {.*\):} $result {} result
  377.     regsub "\n.*" $result {} result
  378.     } else {
  379.     catch {MhExec msgchk -nodate -notify mail} result
  380.     }
  381.  
  382.     return $result
  383. }
  384. proc Mh_MsgCount { spool } {
  385.     return [exec egrep "^From " $spool | wc -l]
  386. }
  387. proc Mh_CurSafe { folder } {
  388.     MhExec folder +$folder -push < /dev/null
  389.     if {[catch {MhExec pick +$folder -list cur} cur]} {
  390.     set cur {}
  391.     }
  392.     MhExec folder -pop < /dev/null
  393.     return $cur
  394. }
  395. proc Mh_Unseen { folder } {
  396.     global mhProfile
  397.     return [Mh_Sequence $folder [lindex [split $mhProfile(unseen-sequence)] 0]]
  398. }
  399. proc Mh_MarkSeen { folder ids } {
  400.     global mhProfile
  401.     if {[catch {
  402.     foreach seq [split $mhProfile(unseen-sequence)] {
  403.         Mh_SequenceUpdate $folder del $seq $ids
  404. #        eval {MhExec mark +$folder -seq $seq -delete} $ids
  405.     }
  406.     } err]} {
  407.     Exmh_Debug Mh_MarkSeen $err
  408.     }
  409. }
  410. proc Mh_MarkUnseen { folder ids } {
  411.     global mhProfile
  412.     if {[catch {
  413.     foreach seq [split $mhProfile(unseen-sequence)] {
  414.         Mh_SequenceUpdate $folder add $seq $ids
  415. #        eval {MhExec mark +$folder -seq $seq} $ids
  416.     }
  417.     } err]} {
  418.     Exmh_Debug Mh_MarkUnseen $err
  419.     }
  420. }
  421.  
  422. proc Mh_SetCur { f msgid } {
  423.     global mhPriv
  424.     if {[info exists mhPriv(cur,$f)] &&
  425.     ($mhPriv(cur,$f) == $msgid)} {
  426.     return
  427.     }
  428.     Exmh_Debug Mh_SetCur +$f cur $msgid
  429.     Mh_SequenceUpdate $f replace cur $msgid
  430. #    catch {MhExec mark +$f $msgid -seq cur -zero}
  431.     set mhPriv(cur,$f) $msgid
  432. }
  433. proc Mh_Cur { f } {
  434.     global mhPriv
  435.     if {[catch {MhCur $f} cur]} {
  436.     set cur [Mh_CurSafe $f]
  437.     }
  438.     set mhPriv(cur,$f) $cur
  439.     return $mhPriv(cur,$f)
  440. }
  441. proc MhCur { f } {
  442.     # pick +folder cur changes the context, so we access the files directly
  443.     global mhProfile mhPriv
  444.     if {$f == {}} {
  445.     return {}
  446.     }
  447.     set cur [Mh_Sequence $f cur]
  448.     if {[file exists $mhProfile(path)/$f/$cur]} {
  449.     return $cur
  450.     } else {
  451.     return {}
  452.     }
  453. }
  454. proc Mh_Sequence { f seq } {
  455.     # pick +folder cur changes the context, so we access the files directly
  456.     global mhProfile mhPriv
  457.     set result {}
  458.     if {[catch {open $mhProfile(path)/$f/$mhProfile(mh-sequences) r} in] == 0} {
  459.     set old [read $in]
  460.     close $in
  461.     foreach line [split $old \n] {
  462.         if {[regexp "^$seq: (.*)" $line x msgs]} {
  463.         return [MhSeqExpand $msgs]
  464.         }
  465.     }
  466.     }
  467.     # private sequences
  468.     if {[catch {open $mhProfile(context) r} in] == 0} {
  469.     set old [read $in]
  470.     close $in
  471.     foreach line [split $old \n] {
  472.         set pattern atr-$seq-$mhProfile(path)/$f
  473.         # Turn off all special characters in folder name (e.g., c++)
  474.         # Thanks to John Farrell
  475.         regsub -all {]|[.^$*+|()\[\\]} $pattern {\\&} pattern
  476.         if {[regexp "$pattern: (.*)" $line x msgs]} {
  477.         return [MhSeqExpand $msgs]
  478.         }
  479.     }
  480.     }
  481.     return {}
  482. }
  483. proc MhSeqExpand { msgs } {
  484.     set result {}
  485.     foreach range [split [string trim $msgs]] {
  486.     set parts [split [string trim $range] -]
  487.     if {[llength $parts] == 1} {
  488.         lappend result $parts
  489.     } else {
  490.         for {set m [lindex $parts 0]} {$m <= [lindex $parts 1]} {incr m} {
  491.         lappend result $m
  492.         }
  493.     }
  494.     }
  495.     return $result
  496. }    
  497. proc Mh_ClearCur { f } {
  498.     Mh_SequenceUpdate $f clear cur
  499. }
  500.  
  501. # Directly modify the context files to add/remove/clear messages
  502. # from a sequence
  503. proc Mh_SequenceUpdate { f how seq {msgs {}} } {
  504.     global mhProfile
  505.     Exmh_Debug Mh_SequenceUpdate $f $how $seq $msgs
  506.     if {[catch {open $mhProfile(path)/$f/$mhProfile(mh-sequences) r} in] == 0} {
  507.     set old [read $in]
  508.     set new {}
  509.     close $in
  510.     set hit 0
  511.     foreach line [split $old \n] {
  512.         if {[regexp ^$seq: $line]} {
  513.         switch -- $how {
  514.             clear { # Do nothing }
  515.             add {
  516.             append new [MhSeq add $line $msgs]\n
  517.             }
  518.             del {
  519.             set tmp [MhSeq del $line $msgs]
  520.             if {[regexp {[0-9]$ *} $tmp]} {
  521.                 append new $tmp\n
  522.             }
  523.             }
  524.             replace {
  525.             append new [MhSeq replace $line $msgs]\n
  526.             }
  527.         }
  528.         set hit 1
  529.         } elseif {[string length $line]} {
  530.         append new $line\n
  531.         }
  532.     }
  533.     if {! $hit} {
  534.         # sequence not found
  535.         if {[regexp {(add|replace)} $how]} {
  536.         append new "$seq: $msgs\n"
  537.         } else {
  538.         return
  539.         }
  540.     }
  541.     if {[catch {open $mhProfile(path)/$f/$mhProfile(mh-sequences).new w} out] == 0} {
  542.         Exmh_Debug New sequences: $mhProfile(path)/$f/$mhProfile(mh-sequences)
  543.         Exmh_Debug $new
  544.         puts -nonewline $out $new
  545.         if {[catch {
  546.         close $out
  547.         } err]} {
  548.         Exmh_Status "Cannot close $mhProfile(path)/$f/$mhProfile(mh-sequences).new: $err"
  549.         } else {
  550.         Mh_Rename $mhProfile(path)/$f/$mhProfile(mh-sequences).new \
  551.             $mhProfile(path)/$f/$mhProfile(mh-sequences)
  552.         }
  553.         return
  554.     }
  555.     }
  556.     # private sequences
  557.     if {[catch {open $mhProfile(context) r} in] == 0} {
  558.     if {[catch {open $mhProfile(context).new w} out] == 0} {
  559.         set hit 0
  560.         while {[gets $in line] >= 0} {
  561.         if {[string match atr-$seq-$mhProfile(path)/$f:* $line]} {
  562.             switch -- $how {
  563.             clear { # Do nothing }
  564.             add {
  565.                 puts $out [MhSeq add $line $msgs] 
  566.             }
  567.             del {
  568.                 puts $out [MhSeq del $line $msgs]
  569.             }
  570.             replace {
  571.                 puts $out [MhSeq replace $line $msgs]
  572.             }
  573.             }
  574.             set hit 1
  575.         } else {
  576.             if {$line != {}} {
  577.             puts $out $line
  578.             }
  579.         }
  580.         }
  581.         if {! $hit} {
  582.         if {[regexp {(add|replace)} $how]} {
  583.             puts $out "atr-$seq-$mhProfile(path)/$f: $msgs"
  584.         }
  585.         }
  586.         close $in
  587.         close $out
  588.         Mh_Rename $mhProfile(context).new $mhProfile(context)
  589.         return
  590.     }
  591.     close $in
  592.     }
  593. }
  594.  
  595. proc MhSeq { how line msgs } {
  596.     if {![regexp {(.*: )(.*)} $line x prefix oldmsgs]} {
  597.     Exmh_Debug MhSeq $how regexp failed $line
  598.     return
  599.     }
  600.     Exmh_Debug MhSeq $how $line $msgs
  601.     set new [MhSeqExpand $msgs]
  602.     set old [MhSeqExpand $oldmsgs]
  603.     if {[string compare $how "add"] == 0} {
  604.     set merge [lsort -integer -increasing [concat $old $new]]
  605.     } elseif {[string compare $how "del"] == 0} {
  606.     set ix 0
  607.     set new [lsort -integer -increasing $new]
  608.     set next [lindex $new 0]
  609.     set merge {}
  610.     foreach id [lsort -integer -increasing $old] {
  611.         while {$id > $next} {
  612.         incr ix
  613.         set next [lindex $new $ix]
  614.         if {[string length $next] == 0} {
  615.             incr ix -1
  616.             set next [lindex $new $ix]
  617.             break
  618.         }
  619.         }
  620.         if {$id == $next} {
  621.         incr ix
  622.         set next [lindex $new $ix]
  623.         } else {
  624.         lappend merge $id
  625.         }
  626.     }
  627.     } else {
  628.     # replace
  629.     Exmh_Debug $prefix $msgs
  630.     return "$prefix $msgs"
  631.     }
  632.     set seq [MhSeqMake $merge]
  633.     Exmh_Debug $prefix $seq
  634.     return "$prefix $seq"
  635. }
  636. proc MhSeqMake { msgs } {
  637.     Exmh_Debug MhSeqMake $msgs
  638.     set result [lindex $msgs 0]
  639.     set first $result
  640.     set last $result
  641.     set id {}
  642.     foreach id [lrange $msgs 1 end] {
  643.     if {$id == $last + 1} {
  644.         set last $id
  645.     } else {
  646.         if {$last != $first} {
  647.         append result -$last
  648.         }
  649.         set first $id
  650.         set last $id
  651.         append result " $first"
  652.     }
  653.     }
  654.     if {$id == $last && [string length $msgs]} {
  655.     append result -$last
  656.     }
  657.     return $result
  658. }
  659.  
  660. proc Mh_Path { folder msg } {
  661.     global mhProfile
  662.     if {[regexp {^[0-9]+$} $msg]} {
  663.     return $mhProfile(path)/$folder/$msg
  664.     } else {
  665.     return [MhExec mhpath +$folder $msg]
  666.     }
  667. }
  668.  
  669. # Note - do not put Exmh_Debug calls into Mh_Refile, Mh_Copy, or Mh_Rmm
  670. # because that seems to open a window that allows the periodic background
  671. # tasks to run.  This causes a race between commit actions and background
  672. # inc/flist actions.
  673.  
  674. proc Mh_Refile {srcFolder msgs folder} {
  675.     while {[llength $msgs] > 0} {
  676.     set chunk [lrange $msgs 0 19]
  677.     set msgs [lrange $msgs 20 end]
  678.     eval {MhExec refile} $chunk {-src +$srcFolder +$folder}
  679.     }
  680. }
  681. proc Mh_RefileFile {folder file} {
  682.     Exmh_Debug exec refile -link -file $file +$folder
  683.     eval {exec refile -link -file $file +$folder}
  684. }
  685. proc Mh_Copy {srcFolder msgs folder} {
  686.     while {[llength $msgs] > 0} {
  687.     set chunk [lrange $msgs 0 19]
  688.     set msgs [lrange $msgs 20 end]
  689.     eval {MhExec refile} $chunk {-link -src +$srcFolder +$folder}
  690.     }
  691. }
  692. proc Mh_Rmm { folder msgs } {
  693.     while {[llength $msgs] > 0} {
  694.     set chunk [lrange $msgs 0 19]
  695.     set msgs [lrange $msgs 20 end]
  696.     eval {MhExec rmm +$folder} $chunk
  697.     }
  698. }
  699. proc Mh_Send { msg } {
  700.     global mhProfile
  701.  
  702.     set path $mhProfile(path)/$mhProfile(draft-folder)/$msg
  703.     set dst [Misc_PostProcess $path]
  704.  
  705.     switch -- $mhProfile(sendType) {
  706.     "async" {
  707.         MhExec $mhProfile(sendproc) -draftf +$mhProfile(draft-folder) \
  708.             -draftm $dst -push -forward < /dev/null
  709.     }
  710.     "wait" {
  711.         MhExec $mhProfile(sendproc) -draftf +$mhProfile(draft-folder) \
  712.             -draftm $dst < /dev/null
  713.     }
  714.     "xterm" {
  715.         eval exec $mhProfile(xtermcmd) { \
  716.         -title "Sending $mhProfile(draft-folder)/$msg ..." \
  717.         -e sh -c "$mhProfile(sendproc) -draftf +$mhProfile(draft-folder) -draftm $dst || whatnow -draftf +$mhProfile(draft-folder) -draftm $dst" &}
  718.  
  719.     }
  720.     }
  721.     if {$msg != $dst} {
  722.     # In case we made a copy during post processing.
  723.     Mh_Rmm $mhProfile(draft-folder) $msg
  724.     }
  725. }
  726. proc Mh_Whom { msg } {
  727.     global mhProfile
  728.     if {![regexp {^[0-9]+$} $msg]} {
  729.     MhExec whom $msg
  730.     } else {
  731.     MhExec whom -draftf +$mhProfile(draft-folder) -draftm $msg
  732.     }
  733. }
  734.  
  735. proc Mh_Sort { f args } {
  736.     if {[catch {eval {MhExec sortm +$f} $args} err]} {
  737.     Exmh_Status $err error
  738.     }
  739. }
  740. proc Mh_Pack { f } {
  741.     if {[catch {MhExec folder +$f -pack} err]} {
  742.     Exmh_Status $err error
  743.     }
  744. }
  745.  
  746. proc MhParseProfile {} {
  747.     global mhProfile env
  748.     if {[info exists env(MH)]} {
  749.     set mhProfile(profile) $env(MH)
  750.     } else {
  751.     set mhProfile(profile) $env(HOME)/.mh_profile
  752.     }
  753.     if {[catch {open $mhProfile(profile) "r"} input]} {
  754.     if {[info exists mhProfile(FAIL)]} {
  755.         puts stderr "Cannot open $mhProfile(profile): $input"
  756.         exit 1
  757.     } else {
  758.         set mhProfile(FAIL) 1
  759.         MhSetupNewUser
  760.         MhParseProfile
  761.         unset mhProfile(FAIL)
  762.         return
  763.     }
  764.     }
  765.     while {![eof $input]} {
  766.     set numBytes [gets $input line]
  767.     if {$numBytes > 0} {
  768.         set parts [split $line :]
  769.         set key [string tolower [lindex $parts 0]]
  770.         set other [lindex $parts 1]
  771.         set value [string trim $other]
  772.         set mhProfile($key) $value
  773.     }
  774.     }
  775.     if {![info exists mhProfile(path)]} {
  776.     if {[info exists mhProfile(FAIL)]} {
  777.         puts stderr "No Path entry in your [file tail $mhProfile(profile)] file."
  778.         puts stderr "Run the \"inc\" command to get your"
  779.         puts stderr "MH environment initialized right."
  780.         exit 1
  781.     } else {
  782.         set mhProfile(FAIL) 1
  783.         MhSetupNewUser
  784.         MhParseProfile
  785.         unset mhProfile(FAIL)
  786.         return
  787.     }
  788.     } else {
  789.     if {[string index $mhProfile(path) 0] != "/"} {
  790.         set mhProfile(path) [glob ~]/$mhProfile(path)
  791.     }
  792.     if {![file isdirectory $mhProfile(path)]} {
  793.         MhSetupNewUserInner
  794.     }
  795.     }
  796.     if {[info exists env(MHCONTEXT)]} {
  797.     set mhProfile(context) $env(MHCONTEXT)
  798.     }
  799.     if {![info exists mhProfile(context)]} {
  800.     set mhProfile(context) context
  801.     }
  802.     set mhProfile(context) [Mh_Pathname $mhProfile(context)]
  803.     if {![file exists $mhProfile(context)]} {
  804.     close [open $mhProfile(context) w]
  805.     }
  806.  
  807.     if {![info exists mhProfile(mh-sequences)]} {
  808.     set mhProfile(mh-sequences) .mh_sequences
  809.     }
  810.     if {$mhProfile(mh-sequences) == {}} {
  811.     set mhProfile(mh-sequences) .mh_sequences
  812.     }
  813.     if {![info exists mhProfile(editor)]} {
  814.     if {[info exists env(EDITOR)]} {
  815.         set mhProfile(editor) $env(EDITOR)
  816.     } else {
  817.         set mhProfile(editor) sedit
  818.     }
  819.     }
  820.     if {![info exists mhProfile(draft-folder)]} {
  821.     MhSetupDraftFolder
  822.     } else {
  823.     set mhProfile(draft-folder) [string trim $mhProfile(draft-folder) +]
  824.     if {![file isdirectory $mhProfile(path)/$mhProfile(draft-folder)]} {
  825.         Exmh_Status "Creating drafts folder"
  826.         if {[catch {exec mkdir $mhProfile(path)/$mhProfile(draft-folder)} msg]} {
  827.         catch {
  828.             puts stderr "Cannot create drafts folder $mhProfile(path)/$mhProfile(draft-folder)"
  829.         }
  830.         }
  831.     }
  832.     }
  833.     if {![info exists mhProfile(unseen-sequence)]} {
  834.     MhSetupUnseenSequence
  835.     }
  836.     if {![info exists mhProfile(header-suppress)]} {
  837.     set mhProfile(header-suppress) {.*}
  838.     } else {
  839.     set suppress {}
  840.     foreach item $mhProfile(header-suppress) {
  841.         lappend suppress [string tolower $item]
  842.     }
  843.     set mhProfile(header-suppress) $suppress
  844.     }
  845.     if {![info exists mhProfile(header-display)]} {
  846.     set mhProfile(header-display) {subject from date to cc newsgroups}
  847.     } else {
  848.     set display {}
  849.     foreach item $mhProfile(header-display) {
  850.         lappend display [string tolower $item]
  851.     }
  852.     set mhProfile(header-display) $display
  853.     }
  854.     if {![info exists mhProfile(folder-order)]} {
  855.     set mhProfile(folder-order) {inbox *}
  856.     }
  857.     if {![info exists mhProfile(folder-unseen)]} {
  858.     set mhProfile(folder-unseen) {*}
  859.     }
  860.     if {![info exists mhProfile(folder-ignore)]} {
  861.     set mhProfile(folder-ignore) {.* */.* */*/.* */*/*/.*}
  862.     }
  863.     foreach key {dist forw repl} {
  864.     global exmh
  865.     set exmh(anno,$key) 0
  866.     set exmh(inplace,$key) 0
  867.     if {[info exists mhProfile($key)]} {
  868.         if {[lsearch $mhProfile($key) -annotate] >= 0} {
  869.         set exmh(anno,$key) 1
  870.         Exmh_Debug "MH anno $key"
  871.         }
  872.         if {[lsearch $mhProfile($key) -inplace] >= 0} {
  873.         set exmh(inplace,$key) 1
  874.         Exmh_Debug "MH inplace $key"
  875.         }
  876.     }
  877.     }
  878.     if {![info exists mhProfile(sendproc)]} {
  879.     set mhProfile(sendproc) send
  880.     }
  881.     if {![info exists mhProfile(msg-protect)]} {
  882.     set mhProfile(msg-protect) 0644
  883.     }
  884. }
  885. proc MhSetupNewUser {} {
  886.     global mhProfile
  887.     Widget_Toplevel .newuser "Setup MH environment"
  888.     Widget_Message .newuser msg -aspect 1000 -text "
  889. Exmh is a front end to the MH mail handling system.
  890. Feel free to send comments and bug reports to
  891.     Brent.Welch@acm.org
  892.  
  893. It appears you have not used the MH mail system before.
  894. (Your [file tail $mhProfile(profile)] is missing or incomplete.)
  895. Normally MH creates a directory named ~/Mail and puts
  896. its mail folders and some other files under there.
  897. If you want your folders elsewhere, you will have to
  898. exit Exmh and run the program install-mh by hand.
  899.  
  900. Is it ok if Exmh sets up your MH environment for you?
  901. "
  902.  
  903.     Widget_Frame .newuser rim Pad {top expand fill}
  904.     .newuser.rim configure -bd 10
  905.  
  906.     Widget_Frame .newuser.rim but Menubar {top fill}
  907.     Widget_AddBut .newuser.rim.but yes "Yes" MhSetupNewUserInner
  908.     Widget_AddBut .newuser.rim.but no "No, Exit" { destroy .newuser ; exit }
  909.     tkwait window .newuser
  910. }
  911. proc MhSetupNewUserInner {} {
  912.     global mhProfile exmh
  913.     set exmh(newuser) 1
  914.     catch {exec mkdir [glob ~]/Mail}
  915.     if {![file exists $mhProfile(profile)]} {
  916.     set out [open $mhProfile(profile) w]
  917.     puts $out "Path: Mail"
  918.     close $out
  919.     }
  920.     catch {MhExec inc < /dev/null} result
  921.     Exmh_Status $result
  922.     catch {destroy .newuser}
  923. }
  924. proc MhSetupDraftFolder {} {
  925.     global mhProfile
  926.     Widget_Toplevel .draft "Setup Draft Folder"
  927.     Widget_Message .draft msg -aspect 1000 -text "
  928. For the Compose, Reply, and Forward operations to work,
  929. you need to have an MH drafts folder.  Creating one
  930. requires making a directory (you choose the name)
  931. and adding a draft-folder: entry
  932. to your [file tail $mhProfile(profile)].
  933.  
  934. Should Exmh help you do that now?"
  935.  
  936.     Widget_Frame .draft rim Pad {top expand fill}
  937.     .draft.rim configure -bd 10
  938.  
  939.     Widget_Label .draft.rim l {left} -text "Folder name: "
  940.     Widget_Entry .draft.rim e {left fill}  -bg white
  941.     .draft.rim.e insert 0 drafts
  942.  
  943.     Widget_Frame .draft.rim but Menubar {top fill}
  944.     Widget_AddBut .draft.rim.but yes "Yes" MhSetupDraftFolderInner
  945.     Widget_AddBut .draft.rim.but no "Exit" { exit }
  946.     update
  947.     tkwait window .draft
  948. }
  949. proc MhSetupDraftFolderInner {} {
  950.     global mhProfile
  951.  
  952.     set dirname [.draft.rim.e get]
  953.     set mhProfile(draft-folder) $dirname
  954.  
  955.     set dir $mhProfile(path)/$mhProfile(draft-folder)
  956.     if {![file isdirectory $dir]} {
  957.     if {[catch {
  958.         exec mkdir $dir
  959.         Exmh_Status "Created drafts folder \"+drafts\""
  960.     } err]} {
  961.         Exmh_Status "Cannot create a drafts folder! $err" error
  962.         unset mhProfile(draft-folder)
  963.         destroy .draft
  964.         return
  965.     }
  966.     }
  967.     if {[catch {open $mhProfile(profile) a} out]} {
  968.     Exmh_Status "Cannot open $mhProfile(profile): $out" error
  969.     unset mhProfile(draft-folder)
  970.     destroy .draft
  971.     return
  972.     }
  973.     puts $out "draft-folder: $dirname"
  974.     Exmh_Status "draft-folder: $dirname"
  975.     close $out
  976.  
  977.     destroy .draft
  978. }
  979. proc MhSetupUnseenSequence {} {
  980.     global mhProfile
  981.     set mhProfile(unseen-sequence) unseen
  982.  
  983.     if {[catch {open $mhProfile(profile) a} out]} {
  984.     Exmh_Status "Cannot open $mhProfile(profile): $out" error
  985.     unset mhProfile(unseen-sequence)
  986.     exit
  987.     }
  988.     catch {puts $out "unseen-sequence: $mhProfile(unseen-sequence)"}
  989.     close $out
  990.     Exmh_Status "Added unseen-sequence to [file tail $mhProfile(profile)]"
  991. }
  992. proc MhSetMailDrops {} {
  993.     global exdrops env mhProfile exdropMtime
  994.  
  995.     global inc
  996.     if {![regexp multi $inc(style)]} {
  997.     return
  998.     }
  999.     if {[file exists $env(HOME)/.exmhdrop]} {
  1000.     catch {puts stderr ".exmhdrop should be named .xmhcheck"}
  1001.     set name .exmhdrop
  1002.     } else {
  1003.     set name .xmhcheck
  1004.     }
  1005.  
  1006.     if {[file exists $env(HOME)/$name]} then {
  1007.     set mtime [file mtime $env(HOME)/$name]
  1008.     if {[info exists exdropMtime]} {
  1009.         if {$mtime <= $exdropMtime} {
  1010.         return
  1011.         }
  1012.     }
  1013.     set exdropMtime $mtime
  1014.     }
  1015.     set exdrops(foo) bar    ;# Ensure empty array variable
  1016.     foreach unique [array names exdrops] {
  1017.     unset exdrops($unique)
  1018.     }
  1019.     if {[file exists $env(HOME)/$name]} then {
  1020.     set df [open $env(HOME)/$name]
  1021.     while {![eof $df]} {
  1022.         # The second field is either a dropbox pathname
  1023.         # (absolute or env(HOME) relative), or it is
  1024.         # a POP hostname followed by an optional POP username
  1025.         gets $df line
  1026.         set fields [scan $line "%s %s %s" f d u]
  1027.         if {$fields < 2} {
  1028.         Exmh_Status "Invalid .xmhcheck: $line"
  1029.         } else {
  1030.         Exmh_Status "Found dropbox $d to folder $f"
  1031.         if {[string first / $d] > 0} {
  1032.             # hostnames ought not to have /'s
  1033.             set d "$env(HOME)/$d"
  1034.         }
  1035.         set folderDirectory "$mhProfile(path)/$f"
  1036.         if {![file isdirectory $folderDirectory]} {
  1037.             Exmh_Status "No directory for folder $f ($name)"
  1038.             continue
  1039.         }
  1040.         # Setup $unique as a unique identifier for this maildrop
  1041.         # avoids clashes when you have 2 drops going to one folder
  1042.             if {$fields == 2} {
  1043.             set u "local"
  1044.         } 
  1045.         set unique "$f-$d-$u"
  1046.         set exdrops($unique) [list $f $d $u]
  1047.         }
  1048.     }
  1049.     close $df
  1050.     } else {
  1051.     catch {puts stderr "Multidrop needs $name mapping file"}
  1052.     }
  1053. }
  1054. proc Mhn_DeleteOrig { msg } {
  1055.     global mhProfile
  1056.     set path $mhProfile(path)/$mhProfile(draft-folder)/$mhProfile(delprefix)$msg
  1057.     if {[file exists $path.orig]} {
  1058.     Exmh_Debug Mhn_DeleteOrig deleting $path.orig
  1059.     File_Delete $path.orig
  1060.     }
  1061. }
  1062.  
  1063. proc Mhn_RenameOrig { msg } {
  1064.     global mhProfile
  1065.     set path $mhProfile(path)/$mhProfile(draft-folder)/$mhProfile(delprefix)$msg
  1066.     if {[file exists $path.orig]} {
  1067.     Exmh_Debug Edit_Done moving $path.orig to $path
  1068.     catch {Mh_Rename $path.orig $path}
  1069.     }
  1070. }
  1071. # Map from a pathname in the MH profile to an absolute pathname.
  1072. proc Mh_Pathname { profile } {
  1073.     global mhProfile
  1074.     if {[string match /* $profile]} {
  1075.     return $profile
  1076.     }
  1077.     if {[regexp {^~/(.*)} $profile match relative]} {
  1078.     return [glob ~]/$relative
  1079.     } elseif {[regexp {^~([^/]+)/(.*)} $profile match user relative]} {
  1080.     return [glob ~$user]/$relative
  1081.     }
  1082.     return $mhProfile(path)/$profile
  1083. }
  1084.  
  1085. set mh_mv_flag -f
  1086. proc Mh_Rename { old new } {
  1087.     global mh_mv_flag tk_version
  1088.     if {$tk_version >= 4.2} {
  1089.     file rename -force $old $new
  1090.     } else {
  1091.     eval exec mv $mh_mv_flag {$old $new} < /dev/null
  1092.     }
  1093. }
  1094.  
  1095. # find a *comp* file going up from the current folder
  1096. proc Mh_FindFile { filename } {
  1097.     global mhProfile exmh
  1098.     if {[file exists [file join $mhProfile(path) $exmh(folder) $filename]]} {
  1099.         return $exmh(folder)
  1100.     }
  1101.     set path $exmh(folder)
  1102.     while {[string compare [set path [file dirname $path]] "."] != 0} {
  1103.         if {[file exists [file join $mhProfile(path) $path $filename]]} {
  1104.             return $path
  1105.         }
  1106.     }
  1107.     # Not found until got to $mhProfile(path), return null string
  1108.     return ""
  1109.     
  1110. }
  1111.